00100	C  MPRNT.F4********** DRAWS MUSIC ON THE PLOTTER OR XGP **********
00200	C *** READS DATA FROM DSK FOR VARIOUS THINGS.
00300	
00400		COMMON /DL/IXRX,SAVER,NAME /FRMT/F78F(1),FA1(1),FA5(1),ASK
00500		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
00600	C					   ↓↓↓↓↓ V IS FOR READIN ONLY
00700		COMMON  /XRN/RN(3000),V(1000) /ALF/INP(72),ML
00800		1 /STF/RSTFAC(-3/4),RSTJ2  /POSI/STFF(-3/4),JJ2,POS
00900		1 /PTR/PWDS(250),ITEM,L,I,M /DPY/GO,TOP,BOT /FONT/JFONT
01000		1/PLTR/PLT,RHT,DIS
01100	
01200		CALL SEGFIX
01300	C  TO ENABLE MULTIPLE USE OF UPPER SEGMENT (TVR)
01400		CALL MPRFAI
01500		END    
01600	
01700	C***** SOME TYPEOUT AND ACCEPT ROUTINES *******
01800	
01900		SUBROUTINE ENDIT(A,ITMS)
02000		TYPE 300,A,ITMS
02100		CALL PLOT(0,0,99)
02200	C  THE END OF THE DATA
02300	300	FORMAT(F7.2,' INCHES',I,' ITEMS')
02400	C  THE END OF THE DATA
02500		END
02600	
02700		SUBROUTINE ILLEGL(JA)
02800		TYPE 160,JA
02900	160	FORMAT(' ILLEGAL STAFF# ',I4)
03000		END
03100	
03200		SUBROUTINE UNKNWN(JA)
03300		TYPE 5700,JA
03400	5700	FORMAT(' UNKNOWN CODE=',I3)
03500	C TRAP FOR UNKNOWN CODE #S (SUCH AS 99 - FOR "NO KSIG".
03600		END
03700	
03800		SUBROUTINE TOOMCH(K)
03900		TYPE 4202,K
04000		STOP
04100	4202	FORMAT(' ***** TOO MUCH DATA ',I4,'/2000')
04200		END
04300	
04400	CCCCCCCCCCCCCCCCCCC  SUBRS.  SLUR, PLTSRT, (LINES, RDRAW),PLTCMD
04500	
04600		SUBROUTINE SLUR
04700		IMPLICIT INTEGER(A-Q,T-Z)
04800		COMMON/SLR/ SLURX(72) /ALF/INP,SLURY(72)
04900		REAL CENTR
05000		COMMON /PLTR/PLT,RHT,RDIS
05100		COMMON R2,JA,CENTR,J2,R3,R4,R5,R6,R7,R8,R9,R10,RA,RB,
05200		1 K,KQ,TWICE,RST7,RX,RXX,RTILT,RC,RZ,RW,J3,J4,
05300		1 J5,J6,J7,J8,J9,J10,J11,JQ(7),R,RJ
05400		COMMON/PTR/PWDS(250),ITEM,L,I,IX /STF/RSTFAC(-3/4),RSTJ2
05500	CF	DATA RZZ/2.8/
05600	C  DEFAULT VALUE OF SLUR CURVE FACTOR IS 2.8
05700	
05800		IF(JA.NE.12)GO TO 2
05900	CF	RA=5.96*RSJT2*R5
06000	CF	L=3
06100	CF	J8=J8*RDIS
06200	CF	IF(J7.LE.J6)J7=J7+360
06300	CF	KQ=6
06400	CF	IF(PLT)KQ=1
06500	CF10	DO 3 K=J6,J7,KQ
06600	CF	R=K
06700	CF	CALL LINES(R3+RA*SIND(R),CENTR+RA*COSD(R),L)
06800	CF3	L=2
06900	CF	J8=J8-1
07000	CF	IF(J8)RETURN
07100	CF	RA=RA+1/RDIS
07200	CF	L=3
07300	CF	GO TO 10
07400	CJA=12  DRAWS CIRCLES. P5=RADIUS, P6=DEGR.1, P7=DEGR.2,P8=THICK(EXPANDS
07500		CALL CIRCLE
07600		RETURN
07700	
07800	2	J10=1
07900		J4=-1
08000		KQ=6
08100		TWICE=-1
08200	C  -1 FOR DISPLAY, USES ONLY 1/3 OF SEGMENTS
08300		IF(PLT.GE.0)GO TO 21
08400		TWICE=0
08500		KQ=1
08600		RWID=.2
08700		IF(RHT.LT.2)GO TO 21
08800		TWICE=1
08900		RWID=.14
09000	C  IF SIZE IS GT.2 3 SLURS ARE DRAWN
09100	21	RST7=RSTJ2*7.
09200		RQQ=R5-R4
09300		IF(R6.GT.1000)CALL RNOTE(R6)
09400		GO TO (5,6,7),J8+4
09500		GO TO 4
09600	5	R=32
09700	C AFTER DOTTED NOTE
09800		GO TO 8
09900	6	R=22
10000	C BETWEEN NOTES
10100	8	RX=-1.3
10200		GO TO 9
10300	7	R=7
10400		RX=RSTJ2
10500	9	CALL RJBX(R)
10600		R6=R6+RX
10700	4	RXX=RHORZ(R6)-R3
10800		RTILT=RQQ*RST7
10900	80	RX=SQRT(RXX**2+RTILT**2)
11000		IF(J8.NE.-1)GO TO 10
11100		IF(RQQ.GT.8)RQQ=8
11200		IF(RQQ.LT.-8)RQQ=-8
11300		RQQ=RQQ*RSTFAC(J2)*1.0
11400		IF(R7)RQQ=-RQQ
11500		R3=R3-RQQ
11600	C  MOVES STEEP SLUR LEFT OR RIGHT IF P8=-1
11700	10	RJ=ABS(R7)
11800	C R7+100=LEFT HALF SLUR, +200=RIGHT HALF, +300=REVERSE DIRECTION.(300 NOT DONE)
11900		IF(RJ.LT.100)RJ=-1
12000		IF(RJ.GE.300)RJ=0
12100		R7=AMOD(R7,100.0)
12200	1	R=CENTR
12300		IF(J8.GT.0)GO TO 180
12400		L=72
12500	C  FOR BRACKETS
12600		CALL SLOOP
12700	CF	RB=RX/71.
12800	CF	DO 81 K=0,71
12900	CF81	SLURX(K+1)=RB*(K)+R3
13000	CF	RA=R7*RST7
13100	CF41	IF(R9.EQ.0)R9=RZZ
13200	CF	R=R+RA
13300	CF	L=0
13400	CF	DO 40 K=36,1,-1
13500	CF	L=L+1
13600	CF	RW=R-RA*(K/36.)**R9
13700	CF	SLURY(L)=RW
13800	CF40	SLURY(73-L)=RW
13900	CF	L=72
14000	
14100	CF89	IF(RTILT.EQ.0)GO TO 87
14200	CF	RW=ATAN2(RTILT,RXX)
14300	CF	RA=SIN(RW)
14400	CF	RB=COS(RW)
14500	CF	RZ=SLURX(1)
14600	CF	RW=SLURY(1)
14700	CF	DO 83 K=1,L
14800	CF	R=SLURX(K)-RZ
14900	CF	RXX=SLURY(K)-RW
15000	CF	SLURX(K)=RB*R-RA*RXX+RZ
15100	CF83	SLURY(K)=RB*RXX+RA*R+RW
15200	
15300	87	IF(J4)CALL LINES(SLURX(J10),SLURY(J10),3)
15400		J5=KQ
15500		J6=J10
15600		J7=L
15700		IF(J4.NE.0)GO TO 22
15800		CALL EXCH(J6,J7)
15900		J5=-1
16000	22	DO 88 K=J6,J7,J5
16100	88	CALL LINES(SLURX(K),SLURY(K),2)
16200		IF(TWICE)RETURN
16300		TWICE=TWICE-1
16400		IF(J8.GT.0)GO TO 182
16500		J4=J4+1
16600		R7=R7+RWID
16700	C  RWID=WIDTH OF SLUR -- SEE DATA
16800		GO TO 1
16900	180	RW=R+R7*RST7
17000		TWICE=-1
17100		KQ=1
17200		RX=RX+R3
17300	CC	RA=(R5-R4)*RST7
17400		IF(J9.EQ.0)GO TO 181
17500		TWICE=2
17600		RZ=RTILT/(RX-R3)
17700		RXX=RX
17800		RWID=(R3+RXX)/2.
17900	182	IF(TWICE.EQ.1)GO TO 183
18000	C  DOES LEFT SIDE FIRST.
18100		IF(TWICE.EQ.0)GO TO 184
18200	C LAST IS NUMBER.
18300		J8=2
18400		RC=RSTJ2*13.
18500		RX=RWID-RC
18600		RWW=RTILT
18700	185	RTILT=RZ*(RX-R3)
18800	
18900	C  PUT IN FUNC. HERE FOR THIS SLOPE AND FOR PART. BEAMS.
19000	
19100		GO TO 181
19200	183	J8=3
19300		RX=RXX
19400		RTILT=RWW
19500		RXX=R3
19600		R3=RWID+RC
19700		RXX=RZ*(R3-RXX)
19800		R=R+RXX
19900		RW=RW+RXX
20000		GO TO 185
20100	
20200	181	SLURX(1)=R3
20300		SLURY(1)=R
20400		SLURX(2)=R3
20500		SLURY(2)=RW
20600		SLURX(3)=RX
20700		SLURY(3)=RW+RTILT
20800		SLURX(4)=RX
20900		SLURY(4)=R+RTILT
21000		L=4
21100		IF(J8.EQ.2)L=3
21200		IF(J8.EQ.3)J10=2
21300	CC	TWICE=-1
21400		GO TO 87
21500	184	J3=RWID
21600	C  PUT IN VERT. POS. WHEN SLOPE!
21700		R4=RQQ/2.+R4+R7-1.
21800		R6=1.
21900		R7=1.
22000		R8=0
22100		CALL MAKNUM(R9)
22200		END
22300	C  8, POS1, STF, NT1, NT2, POS2, DIP(ABS. UNITS), P8
22400	C        FOR P8: 0= SLUR, 1=BRACKETS, 2=LFT ONLY, 3=RT ONLY
22500	
22600	
22700		SUBROUTINE PLTSRT
22800	C  SORTS DATA TO SHORTEN INVISIBLE VECTORS WHEN PLOTTING. 
22900	CF	IMPLICIT INTEGER(S-Z)
23000		COMMON /XRN/RN(4000) /PTR/PWDS(250),ITEM,L,I,IX
23100		DIMENSION  P(250)
23200		CALL PSRT(P)
23300		END
23400	
23500	CF	DO 4 K=1,ITEM
23600	CF	L=PWDS(K)
23700	CF	LL=PWDS(K-1)
23800	CF	LM=PWDS(K+1)
23900	CF	A=RN(L+3)
24000	CF	P(K)=A+1000*RN(L+2)
24100	CF	IF(RN(L+1).NE.16)GO TO 40
24200	CF	Y=PWDS(K-1)
24300	CF	V=PWDS(K+1)
24400	CF	IF(RN(Y+1).EQ.16)GO TO 41
24500	CF	IF(RN(V+1).EQ.16)GO TO 41
24600	CF	GO TO 4
24700	CF40	IF(A.GE.0)GO TO 4
24800	CF41	P(K)=-10000
24900	CF4	CONTINUE
25000	C  PLOTS ALL NEG. POSITIONS FIRST.
25100	CF	IX=I
25200	CF	IF(I.LT.1500)I=1500
25300	CF	Y=I
25400	CF	I=I+IX-1
25500	CF	IX=Y
25600	C  IX IS M IN MAIN PROG.
25700	C  LEAVES 1500 WDS IN RN FOR STORING "NOIR" DATA.
25800	CF2	A=P(1)
25900	CF	L=1
26000	CF	DO 1 K=1,ITEM
26100	CF	IF(A.LE.P(K))GO TO 1
26200	CF	A=P(K)
26300	CF	L=K
26400	CF1	CONTINUE
26500	CF	IF(A.EQ.10000.)RETURN
26600	C  ALL ITEMS HAVE NOW BEEN SHUFFLED
26700	CF	V=PWDS(L)
26800	CF	P(L)=10000
26900	CF	L=RN(V)+2+Y
27000	CF	V=V-Y
27100	CC	CALL LOOP(0,L,1,Y,V,RN)
27200	CF	DO 3 K=Y,L
27300	CF3	RN(K)=RN(K+V)
27400	C  REPLACED SUBROUTINE LOOP
27500	CF	Y=L+1
27600	CF	GO TO 2
27700	CF	END
27800	
27900	
28000	CX	SUBROUTINE LINES(A,B,L)
28100	CX	COMMON /FL/IC,NZ,NX,RZ,XGP
28200	CX	COMMON/DL/IIII,SAVER,AA /PLTR/IPLT,RHT,DIS
28300	CX	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) 
28400	CX	COMMON/DPY/GO,TOP,BOT
28500	CX	DATA BB/260.0/,CC/3.5/,DD/1.43/,MX/512/
28600	C  SET XGP TO 1245.0 FOR MARGIN IN XEROX COPIES
28700	CX22	GO TO 23
28800	C  CHANGE ABOVE TO 'J6CL' IN DDT TO USE NEXT ITEMS.
28900	CX24	AA=CC-DD*ABS(A)/BB
29000	C  USE THIS IN DDT TO DISTORT ITEMS.  CC MUST BE > DD
29100	CX	B=B*AA
29200	CX23	IF(IPLT)GO TO 2
29300	CX	IF(JA.EQ.44)RETURN
29400	CC	K=B
29500	CC	IF(K.GT.ITOP)ITOP=B
29600	CC	IF(K.LT.IBOT)IBOT=B
29700	CX	IF(B.GT.TOP)TOP=B
29800	CX	IF(B.LT.BOT)BOT=B
29900	CX6	RETURN
30000	CC2	IF(IPLT.EQ.-2)RETURN
30100	C RXGP SETS UP-DOWN POS. ON XEROX PAPER (FRACTIONAL POSITIONS POSSIBLE.)
30200	CC	IF(IXRX.EQ.0)GO TO 9
30300	CC	M=ROFF(RXGP-B*RHT)
30400	CC	N=ROFF(XGP+A*DIS)
30500	CC	GO TO 8
30600	CX2	M=ROFF(A*DIS)
30700	CX	N=ROFF(B*RHT)
30800	CX8	CALL PLOT(M,N,L)
30900	CX	END
31000	
31100		SUBROUTINE PLTCMD(NOSET)
31200		COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK /OUTF/JJ
31300		DIMENSION NMS(15),RMOV1(15),RMOV2(15)
31400		COMMON /DL/RSIZ,SAVER,NAME /ALF/INP(72),ML
31500		COMMON R2,JE,CENTR,JB,RJQ(20),JQ(20)
31600		EQUIVALENCE (R5,RJQ(3)),(R6,RJQ(4)),(R7,RJQ(5)),(R4,RJQ(2))
31700		1,(R3,RJQ(1)),(I2,INP(2)),(R8,RJQ(6)),(R9,RJQ(7))
31800	C  BE CAREFUL OF COMMON OVERLAPS WITH NOTWRT,ITMSUB,HOMER, ETC.
31900		DATA F78F(1)/'(78F)'/
32200	
32300		IF(I2.NE.'X')GO TO 1
32400		I2=0
32500	C  I2=X FIRST TIME THROUGH
32700		RMOV1(1)='Y'
32800		NAME=0
32900	14	KA=0
33000	3	KA=KA+1
33100		IF(MLL.EQ.0)GO TO 15
33200		K=K-2
33300		MLL=MLL-1
33400		IF(MLL.EQ.0)GO TO 10
33500		GO TO 31
33600	15	TYPE 2,KA
33700		ACCEPT 11,K,MLL,RSPC
33800	C  TYPE LAST NAME, NUMBER  FOR A SERIES, 2ND NUM FOR FIXED SPACE ".
33900	50	IF(K.NE.' ')GO TO 51
34000		IF(KA.NE.1)GO TO 10
34100	C  DEFAULT NAME IS 'TMP    1'
34200		K='TMP'
34300		MLL=1
34400	51	IF(K.EQ.'99')GO TO 140
34500	C  99=BACKUP
34600		IF(K.NE.'NOSET')GO TO 31
34700		NOSET=-1
34800	C  ACTIVATES ANTI-RESET IN MPRFAI.FAI
34900		GO TO 15
35000	
35100	31	IF(LOOKF(K))GO TO 56
35200	C JUMP IF FILE FOUND
35300		TYPE 55
35400		GO TO 15
35500	55	FORMAT(' FILE NOT FOUND'/)
35600	11	FORMAT(A5,I,F)
35700	56	IF(MLL.LT.99)GO TO 560
35800		MLL=0 
35900	561	K=K+2
36000	C  TYPE 'AAAAA 99'  TO FIND ALL IN 'AAAAx' SERIES AUTOMATICALLY
36100		MLL=MLL+1
36200		IF(LOOKF(K))GO TO 561
36300	C  KEEPS GOING BACK IF FILES ARE FOUND
36400		K=K-2
36500	560	NMS(KA)=K
36600		IF(MLL.EQ.0)GO TO 5
36700		R8='Y'
36800		IF(RSPC.NE.0)R8=RSPC
36900		GO TO 21
37000	5	TYPE 8
37100		ACCEPT 11,R8
37200		IF(R8.EQ.'99')GO TO 15
37300		IF(R8.NE.'Y')R8=0
37400		IF(R8.EQ.0)REREAD F78F,R8
37500	C  MOVE NUMBER CAN BE TYPED FOR 'MOVE UP'
37600	21	RMOV1(KA+1)=R8
37700		RMOV2(KA)=R8
37800		GO TO 3
37900	140	KA=KA-1
38000		GO TO 15
38100	
38200	10	KB=KA-1
38300		IF(I3.NE.'G')GO TO 22
38400		RSIZ=1
38500		GO TO 222
38600	22	TYPE 9
38700		ACCEPT F78F,RSIZ,R9
38800	C  SET R9 TO 1 FOR HEAVY STAFF LINES (FOR XGP MAINLY)
38900		IF(RSIZ.EQ.99)GO TO 5
39000		IF(RSIZ.EQ.0)RSIZ=1.
39100		TYPE 550
39200		ACCEPT 11,JJ
39300		IF(JJ.EQ.' ')JJ='PLT'
39400	550	FORMAT(' TYPE OUTPUT NAME - '$)
39500	222	KA=0
39600	
39700	1	IF(NAME.NE.0)GO TO 12
39800		IF(KA.NE.KB)GO TO 13
39900		I2=-1
40000		RETURN
40100	C  THE END OF THE DATA
40200	13	NAME=NMS(KA+1)
40300		TYPE 111,NAME
40400		RETURN
40500	12	KA=KA+1
40600		NAME=0
40700		R8=0
40800		R2=RSIZ
40900		R3=RSIZ
41000	C  FOR FILLER.  SIZES .LT. 1.6 = EVERY SCAN LINE, .LT. 2.6 = 2, ETC.
41100		R7=0
41200		R5=1
41300		R6=1
41400		IF(RMOV2(KA).NE.'Y')R7=RMOV2(KA)
41500		IF(RMOV1(KA).NE.0)R5=0
41600		IF(RMOV2(KA).NE.0)GO TO 77
41700		IF(R7.EQ.0)RETURN
41800	77	R6=0
41900	2	FORMAT(' TYPE FILE NAME',I2,1X$)
42000	8	FORMAT(' MOVE UP AT END? ',$)
42100	9	FORMAT(' SIZE FACTOR? ',$)
42200	111	FORMAT(1XA5/)
42300		END